home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / WebMap.pprx < prev    next >
Text File  |  1997-05-06  |  40KB  |  1,403 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: WebMap.pprx 1.1 */
  4.  
  5. /** ENG
  6.  This script loads, saves and edits Internet server-side web maps in the
  7.  "NCSA httpd" format. These maps are used to associate different types
  8.  of actions to the selection of different areas of an image.
  9.  
  10.  The following commands are available:
  11.  
  12.  - Load: a web map file can be selected using the file requester;
  13.    the file objects are appended to the current map objects (if any).
  14.  
  15.  - Add Rectangle: the mouse can be used to define a rectangular object
  16.    in the image. An object data requester is opened when the mouse button
  17.    is released.
  18.  
  19.  - Add Circle: the mouse can be used to define a circular object
  20.    in the image. An object data requester is opened when the mouse button
  21.    is released.
  22.  
  23.  - Add Polygon: the mouse can be used to define a polygon object
  24.    in the image; the polygon can be closed by connecting the line
  25.    to the starting point, or with a click of the right mouse button. An
  26.    object data requester is opened when the mouse button is released
  27.    (polygon points can be freely added or removed in the Parameters field).
  28.  
  29.  - Add Freehand Area: the mouse can be used to define a freehand-polygon
  30.    object in the image, the polygon is automatically closed when the mouse
  31.    button is released. An object data requester is opened when the mouse
  32.    button is released.
  33.  
  34.  - Add Point: the mouse can be used to place a point object in the image.
  35.    An object data requester is opened when the mouse button is released.
  36.  
  37.  - Edit: the edit requester contains a list of the map objects; the
  38.    "View by" gadget can be used to list the items by object data, URL
  39.    or comment. A click on the Show gadget causes the selected object
  40.    to be highlighted in the image. The Edit gadget opens a new requester
  41.    with the selected object data: the Parameters, URL and (optional) Comment
  42.    fields can be edited (this requester is very similar to the one
  43.    which appears after an object definition), and the Delete gadget
  44.    can be used to remove the object from the map.
  45.  
  46.  - Save: this command writes a map file using the current object data.
  47.  
  48.  - Export: this command writes an HTML file (client-side map) using the
  49.    current object data. The file contains a sample inline image definition
  50.    which uses the map. The map definition can however be used by other
  51.    images with the USEMAP attribute. Point objects are not yet supported
  52.    by the HTML specification and therefore cannot be exported.
  53.  
  54.  - Clear: all map objects can be deleted with this command (for example,
  55.    before loading a new map).
  56. */
  57.  
  58. /** DEU
  59.  Dieses Skript dient zum Laden, Speichern und Bearbeiten von Internet
  60.  Web-Maps auf der Serverseite im "NCSA httpd"-Format. Solche Maps ermöglichen
  61.  es, bei der Auswahl bestimmter Bildbereiche unterschiedliche Aktionen
  62.  auszulösen.
  63.  
  64.  Die folgenden Befehle stehen zur Verfügung:
  65.  
  66.  - Laden: Mit Hilfe des Dateiauswahlfensters läßt sich die gewünschte Web
  67.    Map-Datei laden. Dabei werden die Dateiobjekte an die aktuellen Map-Objekte
  68.    (falls vorhanden) angehängt.
  69.  
  70.  - Neues Rechteck: Dient zum Auswählen eines rechteckigen Bereichs mit der
  71.    Maus. Sobald die Maustaste losgelassen wird, öffnet sich ein Dialogfenster
  72.    zur Festlegung der Objektdaten.
  73.  
  74.  - Neuer Kreis: Dient zum Auswählen eines kreisförmigen Bereichs mit der
  75.    Maus. Sobald die Maustaste losgelassen wird, öffnet sich ein Dialogfenster
  76.    zur Festlegung der Objektdaten.
  77.  
  78.  - Neues Polygon: Dient zum Erstellen eines Polygonobjekts, welches sich
  79.    entweder durch Verbinden des Linienendes mit dem Anfangspunkt oder durch
  80.    einen Druck auf die rechte Maustaste wieder schließen läßt. Sobald die
  81.    Maustaste losgelassen wird, öffnet sich ein Dialogfenster zur Eingabe der
  82.    Objektdaten.
  83.  
  84.  - Neues freies Polygon: Dient zum Zeichnen eines freihändig gezeichneten
  85.    Polygonobjekts, welches beim Loslassen der linken Maustaste automatisch
  86.    geschlossen wird. Sobald die Maustaste losgelassen wird, öffnet sich ein
  87.    Dialogfenster zur Eingabe der Objektdaten.
  88.  
  89.  - Neuer Punkt: Dient zum Plazieren eines Punktobjekts auf der Bildfläche.
  90.    Sobald die Maustaste losgelassen wird, öffnet sich ein Dialogfenster zur
  91.    Eingabe der Objektdaten.
  92.  
  93.  - Bearbeiten: Das Edit-Dialogfenster enthält eine Liste der vorhandenen
  94.    Map-Objekte. Unter Verwendung des "Anzeigen als"-Symbols lassen sich die
  95.    einzelnen Elemente wahlweise nach Objektdaten, URL oder Kommentar auflisten.
  96.    Durch Anklicken von "Anzeigen" wird das ausgewählte Objekt auf der
  97.    Bildfläche hervorgehoben dargestellt. Das "Bearbeiten"-Symbol dient zum
  98.    Öffnen eines neuen Dialogfensters mit den ausgewählten Objektdaten: Hier
  99.    läßt sich der Feldinhalt für Parameter, URL und einen optionalen Kommentar
  100.    bearbeiten. Mit Hilfe von "Löschen" kann das Objekt aus der aktuellen Map
  101.    entfernt werden. Dieses Dialogfensters ähnelt bezüglich seiner
  102.    Funktionalität sehr stark demjenigen, welches nach einer Objektdefinition
  103.    geöffnet wird.
  104.  
  105.  - Speichern: Dient zum Speichern einer Map-Datei unter Verwendung der
  106.    aktuellen Objektdaten.
  107.  
  108.  - Export: Dieser Befehl schreibt eine HTML-"Client-side Map" unter
  109.    Verwendung der Daten des aktuellen Objekts. Die in eine solche Datei
  110.    eingebettete Bildbeschreibung verwendet diese Map. Selbstverständlich läßt
  111.    sich die Map-Beschreibung aber mit Hilfe des Attributs USEMAP auch mit
  112.    anderen Bildern verwenden. Hinweis: Der Export von Punktobjekten ist nicht
  113.    möglich, da diese noch nicht Bestandteil der HTML-Spezfikation sind.
  114.  
  115.  - Löschen: Bewirkt das Löschen aller Map-Objekte (z. B. vor dem Laden einer
  116.    neuen Map).
  117. */
  118.  
  119. /** ITA
  120.  Questo script permette di leggere, scrivere e modificare mappe di
  121.  collegamento Web sul lato server nel formato "NCSA httpd". Tali mappe
  122.  sono usate per associare vari tipi di azione alla selezione di aree
  123.  differenti dell'immagine.
  124.  
  125.  Sono disponibili i seguenti comandi:
  126.  
  127.  - Leggere: si può selezionare una mappa web tramite la finestra di scelta file;
  128.    gli oggetti del file sono accodati agli oggetti correnti della mappa (se
  129.    presenti).
  130.  
  131.  - Aggiungere rettangolo: si può usare il mouse per definire un oggetto
  132.    rettangolare nell'immagine. Quando si rilascia il tasto del mouse si apre
  133.    la finestra di dialogo relativa ai dati dell'oggetto.
  134.  
  135.  - Aggiungere cerchio: si può usare il mouse per definire un oggetto
  136.    circolare nell'immagine. Quando si rilascia il tasto del mouse si apre
  137.    la finestra di dialogo relativa ai dati dell'oggetto.
  138.  
  139.  - Aggiungere poligono: si può usare il mouse per definire un oggetto
  140.    poligonale nell'immagine; il poligono può essere chiuso congiungendo la
  141.    linea col punto iniziale o facendo click col tasto destro del mouse. Quando
  142.    si rilascia il tasto del mouse si apre la finestra di dialogo relativa ai
  143.    dati dell'oggetto (si possono liberamente aggiungere o togliere punti dal
  144.    poligono tramite il campo Parametri).
  145.  
  146.  - Aggiungere area: si può usare il mouse per definire un oggetto poligonale
  147.    a mano libera nell'immagine, che si chiude automaticamente quando si
  148.    rilascia il tasto del mouse. A questo si apre la finestra di dialogo
  149.    relativa ai dati dell'oggetto.
  150.  
  151.  - Aggiungere punto: si può usare il mouse per piazzare un oggetto punto nella
  152.    immagine. Quando si rilascia il tatso del mouse si apre la finestra di
  153.    dialogo relativa ai dati dell'oggetto.
  154.  
  155.  - Definire: la finestra di dialogo corrispondente contiene un elenco degli
  156.    oggetti della mappa; si può usare il pulsante "Elencare per" per vedere
  157.    le voci elencate in base a dati oggetto, URL o commento. Un click sul
  158.    pulsante Mostrare fa sì che l'oggetto selezionato sia evidenziato nella
  159.    immagine. Il pulsante Definire apre una nuova finestra di dialogo relativa
  160.    ai dati dell'oggetto selezionato: si possono modificare i campi Parametri,
  161.    URL e Commento (opzionale), mentre col pulsante Cancellare si può
  162.    rimuovere l'oggetto dalla mappa.
  163.  
  164.  - Scrivere: questo comando salva il file della mappa usando i dati correnti
  165.    degli oggetti.
  166.  
  167.  - Esportare: questo comando salva un file HTML (mappa lato client) usando i
  168.    dati correnti degli oggetti. Il file contiene una definizione di esempio
  169.    dell'immagine in linea che usa la mappa. La definizione della mappa può però
  170.    essere usata da altre immagini con l'attributo USEMAP. Gli oggetti punto
  171.    non sono ancora definiti come esportabili dalle specifiche HTML.
  172.  
  173.  - Cancellare: con questo comando si pssono eliminare tutti gli oggetti della
  174.    mappa (per esempio, prima di caricare una nuova mappa).
  175. */
  176.  
  177. IF ARG(1, EXISTS) THEN
  178.     PARSE ARG PPPORT
  179. ELSE
  180.     PPPORT = 'PPAINT'
  181.  
  182. IF ~SHOW('P', PPPORT) THEN DO
  183.     IF EXISTS('PPaint:PPaint') THEN DO
  184.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  185.         DO 30 WHILE ~SHOW('P',PPPORT)
  186.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  187.         END
  188.     END
  189.     ELSE DO
  190.         SAY "Personal Paint could not be loaded."
  191.         EXIT 10
  192.     END
  193. END
  194.  
  195. IF ~SHOW('P', PPPORT) THEN DO
  196.     SAY 'Personal Paint Rexx port could not be opened'
  197.     EXIT 10
  198. END
  199.  
  200. ADDRESS VALUE PPPORT
  201. OPTIONS RESULTS
  202. OPTIONS FAILAT 10000
  203.  
  204. Get 'LANG'
  205. IF RESULT = 1 THEN DO        /* Deutsch */
  206.     global.txt_title_menu  = 'Web Map'
  207.     global.txt_title_load  = 'Web Map laden'
  208.     global.txt_title_save  = 'Web Map speichern'
  209.     global.txt_title_exprt = 'Web Map exportieren (HTML)'
  210.     global.txt_title_edit  = 'Web Map bearbeiten'
  211.     global.txt_title_clear = 'Map löschen'
  212.     global.txt_title_rect  = 'Rechteckdaten'
  213.     global.txt_title_circ  = 'Kreisdaten'
  214.     global.txt_title_poly  = 'Polygondaten'
  215.     global.txt_title_point = 'Punktdaten'
  216.     global.txt_title_def   = 'Standarddaten'
  217.  
  218.     global.txt_menu_load   = 'Laden...'
  219.     global.txt_menu_save   = 'Speichern...'
  220.     global.txt_menu_export = 'Exportieren (HTML)...'
  221.     global.txt_menu_rect   = 'Neues Rechteck'
  222.     global.txt_menu_circ   = 'Neuer Kreis'
  223.     global.txt_menu_poly   = 'Neues Polygon'
  224.     global.txt_menu_fhand  = 'Neue freies Polygon'
  225.     global.txt_menu_point  = 'Neuer Punkt'
  226.     global.txt_menu_edit   = 'Bearbeiten...'
  227.     global.txt_menu_clear  = 'Löschen'
  228.  
  229.     global.txt_gad_quit    = '_Verlassen'
  230.     global.txt_gad_del     = '_Löschen'
  231.     global.txt_gad_view    = 'Ansi_cht als:'
  232.     global.txt_gad_view0   = 'Objekt'
  233.     global.txt_gad_view1   = 'URL'
  234.     global.txt_gad_view2   = 'Kommentar'
  235.     global.txt_gad_edit    = '_Bearbeiten'
  236.     global.txt_gad_show    = 'An_zeigen'
  237.     global.txt_gad_exit    = '_Schließen'
  238.     global.txt_gad_param   = 'Pa_rameter:'
  239.     global.txt_gad_url     = '_URL:'
  240.     global.txt_gad_comm    = 'Ko_mmentar:'
  241.  
  242.     global.txt_err_oldcl   = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  243.     global.txt_err_load    = 'Map kann nicht geöffnet werden'
  244.     global.txt_err_nomap   = 'Map ist leer'
  245.     global.txt_err_noclear = 'Map ist bereits leer'
  246.     global.txt_err_save    = 'Map kann nicht gespeichert werden'
  247.     global.txt_err_export  = 'Map kann nicht exportiert werden'
  248.     global.txt_err_expoint = 'Punk-Objekte wurden nicht exportiert'
  249.     global.txt_err_badpar  = 'Parameter sind ungültig'
  250.     global.txt_err_nourl   = 'Fehlende URL-Festlegung '
  251.     global.txt_msg_clear   = 'Map wird gelöscht'
  252. END
  253. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  254.     global.txt_title_menu  = 'Web Map'
  255.     global.txt_title_load  = 'Leggere Web Map'
  256.     global.txt_title_save  = 'Scrivere Web Map'
  257.     global.txt_title_exprt = 'Esportare Web Map (HTML)'
  258.     global.txt_title_edit  = 'Definizione Web Map'
  259.     global.txt_title_clear = 'Cancellare Web Map'
  260.     global.txt_title_rect  = 'Dati rettangolo'
  261.     global.txt_title_circ  = 'Dati cerchio'
  262.     global.txt_title_poly  = 'Dati poligono'
  263.     global.txt_title_point = 'Dati punto'
  264.     global.txt_title_def   = 'Dati URL predefinita'
  265.  
  266.     global.txt_menu_load   = 'Leggere...'
  267.     global.txt_menu_save   = 'Scrivere...'
  268.     global.txt_menu_export = 'Esportare (HTML)...'
  269.     global.txt_menu_rect   = 'Aggiungere rettangolo'
  270.     global.txt_menu_circ   = 'Aggiungere cerchio'
  271.     global.txt_menu_poly   = 'Aggiungere poligono'
  272.     global.txt_menu_fhand  = 'Aggiungere area'
  273.     global.txt_menu_point  = 'Aggiungere punto'
  274.     global.txt_menu_edit   = 'Definire...'
  275.     global.txt_menu_clear  = 'Cancellare'
  276.  
  277.     global.txt_gad_quit    = '_Uscire'
  278.     global.txt_gad_del     = '_Cancellare'
  279.     global.txt_gad_view    = '_Elencare per:'
  280.     global.txt_gad_view0   = 'Oggetto'
  281.     global.txt_gad_view1   = 'URL'
  282.     global.txt_gad_view2   = 'Commento'
  283.     global.txt_gad_edit    = '_Definire'
  284.     global.txt_gad_show    = '_Mostrare'
  285.     global.txt_gad_exit    = '_Uscire'
  286.     global.txt_gad_param   = 'Pa_rametri:'
  287.     global.txt_gad_url     = '_URL:'
  288.     global.txt_gad_comm    = 'Co_mmento:'
  289.  
  290.     global.txt_err_oldcl   = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  291.     global.txt_err_load    = 'Il file non può essere aperto'
  292.     global.txt_err_nomap   = 'La mappa è vuota'
  293.     global.txt_err_noclear = 'La mappa è già vuota'
  294.     global.txt_err_save    = 'Errore nella scrittura del file'
  295.     global.txt_err_export  = 'Errore nella scrittura del file'
  296.     global.txt_err_expoint = 'Uno o più punti non sono stati esportati'
  297.     global.txt_err_badpar  = 'Parametri errati'
  298.     global.txt_err_nourl   = 'URL non specificata'
  299.     global.txt_msg_clear   = 'La mappa verrà cancellata'
  300. END
  301. ELSE DO                /* English */
  302.     global.txt_title_menu  = 'Web Map'
  303.     global.txt_title_load  = 'Load Web Map'
  304.     global.txt_title_save  = 'Save Web Map'
  305.     global.txt_title_exprt = 'Export Web Map (HTML)'
  306.     global.txt_title_edit  = 'Edit Web Map'
  307.     global.txt_title_clear = 'Clear Map'
  308.     global.txt_title_rect  = 'Rectangle Data'
  309.     global.txt_title_circ  = 'Circle Data'
  310.     global.txt_title_poly  = 'Polygon Data'
  311.     global.txt_title_point = 'Point Data'
  312.     global.txt_title_def   = 'Default Data'
  313.  
  314.     global.txt_menu_load   = 'Load...'
  315.     global.txt_menu_save   = 'Save...'
  316.     global.txt_menu_export = 'Export (HTML)...'
  317.     global.txt_menu_rect   = 'Add Rectangle'
  318.     global.txt_menu_circ   = 'Add Circle'
  319.     global.txt_menu_poly   = 'Add Polygon'
  320.     global.txt_menu_fhand  = 'Add Freehand Area'
  321.     global.txt_menu_point  = 'Add Point'
  322.     global.txt_menu_edit   = 'Edit...'
  323.     global.txt_menu_clear  = 'Clear'
  324.  
  325.     global.txt_gad_quit    = '_Quit'
  326.     global.txt_gad_del     = '_Delete'
  327.     global.txt_gad_view    = '_View by:'
  328.     global.txt_gad_view0   = 'Object'
  329.     global.txt_gad_view1   = 'URL'
  330.     global.txt_gad_view2   = 'Comment'
  331.     global.txt_gad_edit    = '_Edit'
  332.     global.txt_gad_show    = '_Show'
  333.     global.txt_gad_exit    = 'E_xit'
  334.     global.txt_gad_param   = 'Pa_rameters:'
  335.     global.txt_gad_url     = '_URL:'
  336.     global.txt_gad_comm    = 'Co_mment:'
  337.  
  338.     global.txt_err_oldcl   = 'This script requires a newer_version of Personal Paint'
  339.     global.txt_err_load    = 'The map file cannot be opened'
  340.     global.txt_err_nomap   = 'The map is empty'
  341.     global.txt_err_noclear = 'The map is already empty'
  342.     global.txt_err_save    = 'The map cannot be saved'
  343.     global.txt_err_export  = 'The map cannot be exported'
  344.     global.txt_err_expoint = 'One or more point object were not exported'
  345.     global.txt_err_badpar  = 'Invalid parameters'
  346.     global.txt_err_nourl   = 'URL not specified'
  347.     global.txt_msg_clear   = 'The map will be cleared'
  348. END
  349.  
  350. global.basename = 'T:PP_WebMap_'PRAGMA('ID')'.'
  351. global.last_url = 'http://www.'
  352.  
  353. Version 'REXX'
  354. IF RESULT < 7 THEN DO
  355.     RequestNotify 'PROMPT "'global.txt_err_oldcl'"'
  356.     EXIT 10
  357. END
  358.  
  359. GetCurrentBrush
  360. savebsh = RESULT
  361. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  362.  
  363. GetPen 'FOREGROUND'
  364. savepen = RESULT
  365. Get 'COLORS'
  366. SetPen 'FOREGROUND' RESULT-1
  367.  
  368. Get 'BARS'
  369. savebars = RESULT
  370. Set '"BARS=2"'
  371.  
  372. Get 'GCLIP'
  373. saveclip = RESULT
  374. Set '"GCLIP=0"'
  375.  
  376. DisableTools
  377.  
  378. SIGNAL ON Break_C
  379.  
  380. command = 0
  381. DO FOREVER
  382.     Request '"'global.txt_title_menu'" ',
  383.             '"LIST ACTION = , 10, 'command', 20, 10, ',
  384.             ' ""'global.txt_menu_load'"", ',
  385.             ' ""'global.txt_menu_save'"", ',
  386.             ' ""'global.txt_menu_export'"", ',
  387.             ' ""'global.txt_menu_rect'"", ',
  388.             ' ""'global.txt_menu_circ'"", ',
  389.             ' ""'global.txt_menu_poly'"", ',
  390.             ' ""'global.txt_menu_fhand'"", ',
  391.             ' ""'global.txt_menu_point'"", ',
  392.             ' ""'global.txt_menu_edit'"", ',
  393.             ' ""'global.txt_menu_clear'""  ',
  394.             ' ACTION = PROCEED ',
  395.             ' ACTION = ""'global.txt_gad_quit'"" "'
  396.  
  397.     IF RESULT = 2 THEN    /* Quit */
  398.         LEAVE
  399.     ELSE DO     /* Proceed / Command List */
  400.         command = RESULT.1
  401.         IF      command = 0 THEN CALL LoadMap
  402.         ELSE IF command = 1 THEN CALL SaveMap
  403.         ELSE IF command = 2 THEN CALL ExportMap
  404.         ELSE IF command = 3 THEN CALL AddRectangle
  405.         ELSE IF command = 4 THEN CALL AddCircle
  406.         ELSE IF command = 5 THEN CALL AddPolygon
  407.         ELSE IF command = 6 THEN CALL AddFreehand
  408.         ELSE IF command = 7 THEN CALL AddPoint
  409.         ELSE IF command = 8 THEN CALL EditMap
  410.         ELSE IF command = 9 THEN CALL ClearMap
  411.     END
  412. END
  413.  
  414. CALL Break_C
  415. EXIT 0
  416.  
  417.  
  418.  
  419.  
  420.  
  421. LoadMap: PROCEDURE EXPOSE global.
  422.  
  423.     RequestFile 'TITLE "'global.txt_title_load'"'
  424.     IF RC = 0 THEN DO
  425.         PARSE VALUE RESULT WITH '"' mfilename '"'
  426.         IF OPEN('mfile', mfilename, 'R') THEN DO
  427.             LockGUI
  428.             comment = ''
  429.             DO FOREVER
  430.                 mline = READLN('mfile')
  431.                 IF EOF('mfile') THEN
  432.                     LEAVE
  433.                 mline = STRIP(mline)
  434.                 IF LEFT(mline, 1) = '#' THEN
  435.                     comment = comment STRIP(SUBSTR(mline, 2))
  436.                 ELSE DO
  437.                     PARSE VAR mline obtype url param
  438.                     obtype = TRANSLATE(obtype, XRANGE('a','z'), XRANGE('A', 'Z'))    /* convert to lower case */
  439.                     param = STRIP(TRANSLATE(param, ' ', ','))
  440.                     comment = STRIP(comment)
  441.  
  442.                     IF obtype = 'rect' | ,
  443.                         obtype = 'circle' | ,
  444.                         obtype = 'poly' |,
  445.                         obtype = 'point' THEN DO
  446.  
  447.                         CALL XorObject(obtype, param)
  448.                         CALL AddObject(obtype, 0 '"'param'" "'url'" "'comment'"')
  449.                     END
  450.                     ELSE IF obtype = 'default' THEN DO
  451.                         IF OPEN('obfile', global.basename || 'def', 'W') THEN DO
  452.                             CALL WRITELN('obfile', url)
  453.                             CALL WRITELN('obfile', comment)
  454.                             CALL CLOSE('obfile')
  455.                         END
  456.                     END
  457.                     comment = ''
  458.                 END
  459.             END
  460.             CALL CLOSE('mfile')
  461.             UnlockGUI
  462.         END
  463.         ELSE RequestNotify 'TITLE "'global.txt_title_load'" PROMPT "'global.txt_err_load'"'
  464.     END
  465.  
  466.     RETURN
  467.  
  468.  
  469.  
  470.  
  471. AddRectangle: PROCEDURE EXPOSE global.
  472.  
  473.     SetPointer 'DATA ',
  474.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  475.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  476.         ' 0x0000,0x0000,0x0000,0x1FE0,0x1020,0x1020,0x1020,0x1FE0,',
  477.         ' 0x0000,',
  478.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  479.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  480.         ' 0x0000,0x0000,0x0000,0x0000,0x0FD0,0x0810,0x0810,0x0010,',
  481.         ' 0x0FF0" ',
  482.         'HEIGHT 25 OFFSETX -8 OFFSETY -7'
  483.  
  484.     WaitForClick 'DOWN POINT SHOWBRUSH'
  485.     IF RC = 0 THEN DO
  486.         PARSE VAR RESULT button x0 y0 .
  487.         prev_xp = x0
  488.         prev_yp = y0
  489.         drawn = 0
  490.  
  491.         DO FOREVER
  492.             GetMousePosition
  493.             PARSE VAR RESULT xp yp .
  494.  
  495.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  496.                 IF drawn THEN
  497.                     Undo
  498.                 DrawRectangle x0 y0 xp yp 'COMPLEMENT'
  499.  
  500.                 prev_xp = xp
  501.                 prev_yp = yp
  502.                 drawn = 1
  503.             END
  504.             ELSE WaitForEvent
  505.  
  506.             GetMouseButton
  507.             IF RESULT ~= button THEN
  508.                 LEAVE
  509.         END
  510.  
  511.         IF x0 > xp THEN DO
  512.             t = x0
  513.             x0 = xp
  514.             xp = t
  515.         END
  516.         IF y0 > yp THEN DO
  517.             t = y0
  518.             y0 = yp
  519.             yp = t
  520.         END
  521.  
  522.         objdata = RequestObject(global.txt_title_rect, 'rect', x0','y0 xp','yp, '', '', 0)
  523.         IF objdata = 'cancel' THEN
  524.             erase_it = 1
  525.         ELSE
  526.             PARSE VAR objdata erase_it .
  527.         IF erase_it THEN
  528.             DrawRectangle x0 y0 xp yp 'COMPLEMENT'
  529.  
  530.         IF objdata ~= 'cancel' THEN DO
  531.             IF erase_it THEN DO
  532.                 PARSE VALUE objdata WITH . '"' param '"' .
  533.                 DrawRectangle param 'COMPLEMENT'
  534.             END
  535.             CALL AddObject('rect', objdata)
  536.         END
  537.     END
  538.     SetPointer
  539.     RETURN
  540.  
  541.  
  542.  
  543.  
  544. AddCircle: PROCEDURE EXPOSE global.
  545.  
  546.     SetPointer 'DATA ',
  547.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  548.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  549.         ' 0x0000,0x0000,0x0000,0x0780,0x0840,0x1020,0x1020,0x1020,',
  550.         ' 0x0840,0x0780,',
  551.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  552.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  553.         ' 0x0000,0x0000,0x0000,0x0040,0x0420,0x0810,0x0810,0x0810,',
  554.         ' 0x0420,0x0040" ',
  555.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  556.  
  557.     WaitForClick 'DOWN POINT SHOWBRUSH'
  558.     IF RC = 0 THEN DO
  559.         PARSE VAR RESULT button x0 y0 .
  560.         prev_xp = x0
  561.         prev_yp = y0
  562.         drawn = 0
  563.  
  564.         DO FOREVER
  565.             GetMousePosition
  566.             PARSE VAR RESULT xp yp .
  567.  
  568.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  569.                 IF drawn THEN
  570.                     Undo
  571.                 GetDistance x0 y0 xp yp 'IMAGERATIO'
  572.                 radius = RESULT
  573.                 DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  574.  
  575.                 prev_xp = xp
  576.                 prev_yp = yp
  577.                 drawn = 1
  578.             END
  579.             ELSE WaitForEvent
  580.  
  581.             GetMouseButton
  582.             IF RESULT ~= button THEN
  583.                 LEAVE
  584.         END
  585.  
  586.         objdata = RequestObject(global.txt_title_circ, 'circle', x0','y0 xp','yp, '', '', 0)
  587.         IF objdata = 'cancel' THEN
  588.             erase_it = 1
  589.         ELSE
  590.             PARSE VAR objdata erase_it .
  591.         IF erase_it THEN DO
  592.             DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  593.         END
  594.  
  595.         IF objdata ~= 'cancel' THEN DO
  596.             IF erase_it THEN DO
  597.                 PARSE VALUE objdata WITH . '"' x0 y0 xp yp '"' .
  598.                 GetDistance x0 y0 xp yp 'IMAGERATIO'
  599.                 radius = RESULT
  600.                 DrawCircle x0 y0 'RADIUSX' radius 'COMPLEMENT'
  601.             END
  602.             CALL AddObject('circle', objdata)
  603.         END
  604.     END
  605.     SetPointer
  606.     RETURN
  607.  
  608.  
  609.  
  610.  
  611. AddPolygon: PROCEDURE EXPOSE global.
  612.  
  613.     SetPointer 'DATA ',
  614.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,,',
  615.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,,',
  616.         ' 0x0000,0x0000,0x0000,0x0400,0x0A80,0x1140,0x0820,0x0440,,',
  617.         ' 0x0280,0x0100,',
  618.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,,',
  619.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,,',
  620.         ' 0x0000,0x0000,0x0000,0x0200,0x0540,0x08A0,0x0410,0x0220,,',
  621.         ' 0x0140,0x0080" ',
  622.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  623.  
  624.     WaitForClick 'DOWN POINT SHOWBRUSH'
  625.     IF RC = 0 THEN DO
  626.         PARSE VAR RESULT button x0 y0 .
  627.         prev_xp = x0
  628.         prev_yp = y0
  629.         xs = x0
  630.         ys = y0
  631.         xcoord.0 = x0
  632.         ycoord.0 = y0
  633.         points = 1
  634.         bpressed = 1
  635.         drawn = 0
  636.  
  637.         DO FOREVER
  638.             GetMousePosition
  639.             PARSE VAR RESULT xp yp .
  640.  
  641.             IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  642.                 IF drawn THEN
  643.                     Undo
  644.                 DrawLine xs ys xp yp 'COMPLEMENT NOFIRSTPIXEL'
  645.  
  646.                 prev_xp = xp
  647.                 prev_yp = yp
  648.                 drawn = 1
  649.             END
  650.             ELSE WaitForEvent
  651.  
  652.             GetMouseButton
  653.             IF RESULT = 0 THEN DO
  654.                 IF bpressed THEN DO
  655.                     bpressed = 0
  656.                     dx0 = ABS(prev_xp - x0)
  657.                     dy0 = ABS(prev_yp - y0)
  658.                     IF dx0 < 3 & dy0 < 3 & points > 1 THEN
  659.                         LEAVE
  660.                     IF xs ~= prev_xp | ys ~= prev_yp THEN DO
  661.                         xs = prev_xp
  662.                         ys = prev_yp
  663.                         xcoord.points = xs
  664.                         ycoord.points = ys
  665.                         points = points + 1
  666.                         drawn = 0
  667.                     END
  668.                 END
  669.             END
  670.             ELSE DO
  671.                 IF RESULT ~= button THEN
  672.                     LEAVE
  673.                 bpressed = 1
  674.             END
  675.         END
  676.  
  677.         IF drawn THEN
  678.             Undo
  679.         DrawLine xs ys x0 y0 'COMPLEMENT NOFIRSTPIXEL'
  680.  
  681.         objdata = RequestObject(global.txt_title_poly, 'poly', PointString('xcoord', 'ycoord', ',', points), '', '', 0)
  682.         IF objdata = 'cancel' THEN
  683.             erase_it = 1
  684.         ELSE
  685.             PARSE VAR objdata erase_it .
  686.         IF erase_it THEN
  687.             DrawPolygon '"' PointString('xcoord', 'ycoord', ' ', points) '" COMPLEMENT'
  688.  
  689.         IF objdata ~= 'cancel' THEN DO
  690.             IF erase_it THEN DO
  691.                 PARSE VALUE objdata WITH . '"' param '"' .
  692.                 DrawPolygon '"'param'" COMPLEMENT'
  693.             END
  694.             CALL AddObject('poly', objdata)
  695.         END
  696.     END
  697.     SetPointer
  698.     RETURN
  699.  
  700.  
  701.  
  702.  
  703. AddFreehand: PROCEDURE EXPOSE global.
  704.  
  705.     SetPointer 'DATA ',
  706.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  707.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  708.         ' 0x0000,0x0000,0x0000,0x0600,0x0900,0x10C0,0x1020,0x0820,',
  709.         ' 0x0640,0x0180,',
  710.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  711.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  712.         ' 0x0000,0x0000,0x0000,0x0100,0x0480,0x0820,0x0810,0x0410,',
  713.         ' 0x0120,0x0040" ',
  714.         'HEIGHT 26 OFFSETX -8 OFFSETY -7'
  715.  
  716.     WaitForClick 'DOWN POINT SHOWBRUSH'
  717.     IF RC = 0 THEN DO
  718.         PARSE VAR RESULT button x0 y0 .
  719.         prev_xp = x0
  720.         prev_yp = y0
  721.         xcoord.0 = x0
  722.         ycoord.0 = y0
  723.         points = 1
  724.  
  725.         DO FOREVER
  726.             GetMousePosition
  727.             PARSE VAR RESULT xp yp .
  728.  
  729.             IF xp ~= prev_xp | yp ~= prev_yp THEN DO
  730.                 DrawLine prev_xp prev_yp xp yp 'COMPLEMENT NOFIRSTPIXEL'
  731.  
  732.                 xcoord.points = xp
  733.                 ycoord.points = yp
  734.                 points = points + 1
  735.  
  736.                 prev_xp = xp
  737.                 prev_yp = yp
  738.             END
  739.             ELSE WaitForEvent
  740.  
  741.             GetMouseButton
  742.             IF RESULT ~= button THEN
  743.                 LEAVE
  744.         END
  745.         DrawLine prev_xp prev_yp x0 y0 'COMPLEMENT NOFIRSTPIXEL'
  746.  
  747.         objdata = RequestObject(global.txt_title_poly, 'poly', PointString('xcoord', 'ycoord', ',', points), '', '', 0)
  748.         IF objdata = 'cancel' THEN
  749.             erase_it = 1
  750.         ELSE
  751.             PARSE VAR objdata erase_it .
  752.         IF erase_it THEN
  753.             DrawPolygon '"' PointString('xcoord', 'ycoord', ' ', points) '" COMPLEMENT'
  754.  
  755.         IF objdata ~= 'cancel' THEN DO
  756.             IF erase_it THEN DO
  757.                 PARSE VALUE objdata WITH . '"' param '"' .
  758.                 DrawPolygon '"'param'" COMPLEMENT'
  759.             END
  760.             CALL AddObject('poly', objdata)
  761.         END
  762.     END
  763.     SetPointer
  764.     RETURN
  765.  
  766.  
  767.  
  768.  
  769. AddPoint: PROCEDURE EXPOSE global.
  770.  
  771.     SetPointer 'DATA ',
  772.         '"0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,0xA82A,',
  773.         ' 0x0000,0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,',
  774.         ' 0x0000,0x0000,0x0000,0x0000,0x0780,0x0780,0x0780,0x0000,',
  775.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x5454,',
  776.         ' 0x0000,0x0100,0x0000,0x0100,0x0000,0x0100,0x0000,0x0000,',
  777.         ' 0x0000,0x0000,0x0000,0x0000,0x0000,0x0040,0x0040,0x03C0" ',
  778.         'HEIGHT 24 OFFSETX -8 OFFSETY -7'
  779.  
  780.     WaitForClick 'DOWN POINT SHOWBRUSH'
  781.     IF RC = 0 THEN DO
  782.         PARSE VAR RESULT button x0 y0 .
  783.         prev_xp = x0
  784.         prev_yp = y0
  785.  
  786.         SetCurrentBrush 'RECTANGULAR WIDTH 5 HEIGHT 5'
  787.         DisableTools
  788.         PutBrush x0 y0 'COMPLEMENT'
  789.  
  790.         DO FOREVER
  791.             GetMousePosition
  792.             PARSE VAR RESULT xp yp .
  793.  
  794.             IF xp ~= prev_xp | yp ~= prev_yp THEN DO
  795.                 Undo
  796.                 PutBrush xp yp 'COMPLEMENT'
  797.  
  798.                 prev_xp = xp
  799.                 prev_yp = yp
  800.             END
  801.             ELSE WaitForEvent
  802.  
  803.             GetMouseButton
  804.             IF RESULT ~= button THEN
  805.                 LEAVE
  806.         END
  807.  
  808.         objdata = RequestObject(global.txt_title_point, 'point', xp','yp, '', '', 0)
  809.         IF objdata = 'cancel' THEN
  810.             erase_it = 1
  811.         ELSE
  812.             PARSE VAR objdata erase_it .
  813.         IF erase_it THEN
  814.             PutBrush xp yp 'COMPLEMENT'
  815.  
  816.         IF objdata ~= 'cancel' THEN DO
  817.             IF erase_it THEN DO
  818.                 PARSE VALUE objdata WITH . '"' param '"' .
  819.                 PutBrush param 'COMPLEMENT'
  820.             END
  821.             CALL AddObject('point', objdata)
  822.         END
  823.         SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  824.         DisableTools
  825.     END
  826.     SetPointer
  827.     RETURN
  828.  
  829.  
  830.  
  831.  
  832. EditMap: PROCEDURE EXPOSE global.
  833.  
  834.     obnum = GetObjectNum()
  835.  
  836.     IF obnum = 0 THEN DO
  837.         RequestNotify 'TITLE "'global.txt_title_edit'" PROMPT "'global.txt_err_nomap'"'
  838.         RETURN
  839.     END
  840.  
  841.     tnum = obnum + 1
  842.     def = obnum
  843.  
  844.     DO ob = 0 FOR obnum
  845.         IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  846.             obtype.ob  = READLN('obfile')
  847.             param.ob   = InsertCommas(READLN('obfile'))
  848.             url.ob     = READLN('obfile')
  849.             comment.ob = READLN('obfile')
  850.             CALL CLOSE('obfile')
  851.         END
  852.     END
  853.     IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  854.         url.def     = READLN('obfile')
  855.         comment.def = READLN('obfile')
  856.         CALL CLOSE('obfile')
  857.     END
  858.     ELSE DO
  859.         url.def     = ''
  860.         comment.def = ''
  861.     END
  862.     obtype.def = 'default'
  863.     param.def  = ''
  864.  
  865.     action = 0
  866.     selected = 0
  867.     view_by = 0
  868.     IF OPEN('edfile', global.basename || 'edit', 'R') THEN DO
  869.         selected = READLN('edfile')
  870.         view_by = READLN('edfile')
  871.         CALL CLOSE('edfile')
  872.     END
  873.  
  874.     LockGUI
  875.     DO WHILE action ~= 3 & obnum > 0
  876.         req = '"LIST = , 'tnum', 'selected', 26, 8'
  877.         IF view_by = 0 THEN DO
  878.             DO ob = 0 FOR tnum
  879.                 req = req || ', ""' || obtype.ob param.ob '""'
  880.             END
  881.         END
  882.         ELSE IF view_by = 1 THEN DO
  883.             DO ob = 0 FOR tnum
  884.                 IF url.ob ~= '' THEN
  885.                     req = req || ', ""' || url.ob '""'
  886.                 ELSE
  887.                     req = req || ', . '
  888.             END
  889.         END
  890.         ELSE IF view_by = 2 THEN DO
  891.             DO ob = 0 FOR tnum
  892.                 IF comment.ob ~= '' THEN
  893.                     req = req || ', ""' || comment.ob '""'
  894.                 ELSE
  895.                     req = req || ', . '
  896.             END
  897.         END
  898.  
  899.         req = req ||,
  900.             'CYCLE ACTION = ""'global.txt_gad_view'"", 3, 'view_by', ""'global.txt_gad_view0'"", ""'global.txt_gad_view1'"", ""'global.txt_gad_view2'"" ' ||,
  901.             'ACTION = ""'global.txt_gad_edit'"" ' ||,
  902.             'ACTION = ""'global.txt_gad_show'"" ' ||,
  903.             'ACTION = ""'global.txt_gad_exit'"" "'
  904.  
  905.         Request '"'global.txt_title_edit'" RESIZE 'req
  906.         action   = RESULT
  907.         selected = RESULT.1
  908.         view_by  = RESULT.2
  909.  
  910.         IF action = 1 THEN DO    /* Edit */
  911.             IF obtype.selected = 'rect' THEN
  912.                 title = global.txt_title_rect
  913.             ELSE IF obtype.selected = 'circle' THEN
  914.                 title = global.txt_title_circ
  915.             ELSE IF obtype.selected = 'poly' THEN
  916.                 title = global.txt_title_poly
  917.             ELSE IF obtype.selected = 'point' THEN
  918.                 title = global.txt_title_point
  919.             ELSE
  920.                 title = global.txt_title_def
  921.  
  922.             objdata = RequestObject(title, obtype.selected, param.selected, url.selected, comment.selected, 1)
  923.  
  924.             IF objdata = 'delete' THEN DO        /* Delete */
  925.                 IF selected ~= def THEN DO
  926.                     CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  927.  
  928.                     ADDRESS COMMAND 'Delete >NIL: 'global.basename || selected
  929.  
  930.                     IF selected < obnum THEN DO
  931.                         obmax = tnum - 2
  932.                         DO ob = selected TO obmax
  933.                             nob = ob + 1
  934.                             obtype.ob  = obtype.nob
  935.                             param.ob   = param.nob
  936.                             url.ob     = url.nob
  937.                             comment.ob = comment.nob
  938.                             IF ob < obmax THEN
  939.                                 ADDRESS COMMAND 'Rename >NIL: 'global.basename || nob  global.basename || ob
  940.                         END
  941.                     END
  942.                     obnum = obnum - 1
  943.                     tnum = obnum + 1
  944.                     def = obnum
  945.                     CALL SetObjectNum(obnum)
  946.  
  947.                     IF selected >= obnum & obnum > 0 THEN
  948.                         selected = obnum - 1
  949.                 END
  950.                 ELSE DO    /* default */
  951.                     ADDRESS COMMAND 'Delete >NIL: 'global.basename || 'def'
  952.                     url.def     = ''
  953.                     comment.def = ''
  954.                 END
  955.             END
  956.             ELSE IF objdata ~= 'cancel' THEN DO        /* Proceed */
  957.                 IF selected ~= def THEN DO
  958.                     PARSE VAR objdata new_par .
  959.                     IF new_par THEN
  960.                         CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  961.  
  962.                     PARSE VALUE objdata WITH . '"' param.selected '" "' url.selected '" "' comment.selected '"' .
  963.                     IF new_par THEN
  964.                         CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  965.  
  966.                     IF OPEN('obfile', global.basename || selected, 'W') THEN DO
  967.                         CALL WRITELN('obfile', obtype.selected)
  968.                         CALL WRITELN('obfile', TRANSLATE(param.selected, ' ', ','))
  969.                         CALL WRITELN('obfile', url.selected)
  970.                         CALL WRITELN('obfile', comment.selected)
  971.                         CALL CLOSE('obfile')
  972.                     END
  973.                 END
  974.                 ELSE DO    /* default */
  975.                     PARSE VALUE objdata WITH '"' url.selected '" "' comment.selected '"' .
  976.  
  977.                     IF OPEN('sfile', global.basename || 'def', 'W') THEN DO
  978.                         CALL WRITELN('sfile', url.selected)
  979.                         CALL WRITELN('sfile', comment.selected)
  980.                         CALL CLOSE('sfile')
  981.                     END
  982.                 END
  983.             END
  984.         END
  985.         ELSE IF action = 2 & selected ~= def THEN DO        /* Show */
  986.             CALL XorObject(obtype.selected, TRANSLATE(param.selected, ' ', ','))
  987.             times = 5
  988.             DO tm = 1 TO times
  989.                 Wait 'TIME 120'
  990.                 Undo
  991.                 IF tm < times THEN DO
  992.                     Wait 'TIME 120'
  993.                     Redo
  994.                 END
  995.             END
  996.         END
  997.     END
  998.     UnlockGUI
  999.  
  1000.     IF OPEN('sfile', global.basename || 'edit', 'W') THEN DO
  1001.         CALL WRITELN('sfile', selected)
  1002.         CALL WRITELN('sfile', view_by)
  1003.         CALL CLOSE('sfile')
  1004.     END
  1005.  
  1006.     RETURN
  1007.  
  1008.  
  1009.  
  1010.  
  1011. SaveMap: PROCEDURE EXPOSE global.
  1012.  
  1013.     obnum = GetObjectNum()
  1014.  
  1015.     IF obnum > 0 THEN DO
  1016.         RequestFile 'TITLE "'global.txt_title_save'" SAVEMODE'
  1017.         IF RC = 0 THEN DO
  1018.             PARSE VALUE RESULT WITH '"' mfilename '"'
  1019.             IF OPEN('mfile', mfilename, 'W') THEN DO
  1020.                 LockGUI
  1021.                 GetImageAttributes 'NAME'
  1022.                 CALL WRITELN('mfile', '# Map file for "'RESULT'" ('obnum' objects)')
  1023.  
  1024.                 DO ob = 0 FOR obnum
  1025.                     IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  1026.                         obtype  = READLN('obfile')
  1027.                         param   = READLN('obfile')
  1028.                         url     = READLN('obfile')
  1029.                         comment = READLN('obfile')
  1030.  
  1031.                         CALL WRITELN('mfile', '')
  1032.                         IF comment ~= '' THEN
  1033.                             CALL WRITELN('mfile', '# 'comment)
  1034.                         CALL WRITELN('mfile', obtype url InsertCommas(param))
  1035.  
  1036.                         CALL CLOSE('obfile')
  1037.                     END
  1038.                 END
  1039.                 IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  1040.                     url = READLN('obfile')
  1041.                     comment = READLN('obfile')
  1042.                     CALL WRITELN('mfile', '')
  1043.                     IF comment ~= '' THEN
  1044.                         CALL WRITELN('mfile', '# 'comment)
  1045.                     CALL WRITELN('mfile', 'default 'url)
  1046.                     CALL CLOSE('obfile')
  1047.                 END
  1048.                 CALL CLOSE('mfile')
  1049.                 UnlockGUI
  1050.             END
  1051.             ELSE RequestNotify 'TITLE "'global.txt_title_save'" PROMPT "'global.txt_err_save'"'
  1052.         END
  1053.     END
  1054.     ELSE RequestNotify 'TITLE "'global.txt_title_save'" PROMPT "'global.txt_err_nomap'"'
  1055.  
  1056.     RETURN
  1057.  
  1058.  
  1059.  
  1060. ExportMap: PROCEDURE EXPOSE global.
  1061.  
  1062.     obnum = GetObjectNum()
  1063.  
  1064.     IF obnum > 0 THEN DO
  1065.         RequestFile 'TITLE "'global.txt_title_exprt'" SAVEMODE'
  1066.         IF RC = 0 THEN DO
  1067.             PARSE VALUE RESULT WITH '"' mfilename '"'
  1068.             IF OPEN('mfile', mfilename, 'W') THEN DO
  1069.                 LockGUI
  1070.                 GetImageAttributes 'NAME'
  1071.                 imgname = RESULT
  1072.                 ppos = INDEX(imgname, '.')
  1073.                 IF ppos > 1 THEN
  1074.                     mapname = LEFT(imgname, ppos - 1)
  1075.                 ELSE
  1076.                     mapname = imgname
  1077.                 point_found = 0
  1078.  
  1079.                 CALL WRITELN('mfile', '<!-- Map file for "'imgname'" ('obnum' objects) -->')
  1080.  
  1081.                 CALL WRITELN('mfile', '0a'X'<H1>Imagemap</H1>')
  1082.                 CALL WRITELN('mfile', '<IMG SRC="'imgname'" USEMAP="#'mapname'">')
  1083.                 CALL WRITELN('mfile', '<MAP NAME="'mapname'">')
  1084.  
  1085.                 DO ob = 0 FOR obnum
  1086.                     IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  1087.                         obtype  = READLN('obfile')
  1088.                         param   = READLN('obfile')
  1089.                         url     = READLN('obfile')
  1090.                         comment = READLN('obfile')
  1091.  
  1092.                         IF obtype = 'point' THEN
  1093.                             point_found = 1
  1094.                         ELSE DO
  1095.                             IF obtype = 'poly' THEN
  1096.                                 obtype = 'polygon'
  1097.  
  1098.                             CALL WRITECH('mfile', '<AREA SHAPE="'obtype'" ')
  1099.  
  1100.                             IF comment ~= '' THEN
  1101.                                 CALL WRITECH('mfile', 'ALT="'comment'" ')
  1102.  
  1103.                             IF obtype = 'circle' THEN DO
  1104.                                 PARSE VAR param x0 y0 x1 y1 .
  1105.                                 GetDistance x0 y0 x1 y1 'IMAGERATIO'
  1106.                                 param = x0 y0 RESULT
  1107.                             END
  1108.  
  1109.                             CALL WRITELN('mfile', 'COORDS="' || TRANSLATE(param, ',', ' ') || '" HREF="'url'">')
  1110.                         END
  1111.                         CALL CLOSE('obfile')
  1112.                     END
  1113.                 END
  1114.                 IF OPEN('obfile', global.basename || 'def', 'R') THEN DO
  1115.                     url = READLN('obfile')
  1116.                     comment = READLN('obfile')
  1117.                     CALL WRITECH('mfile', '<AREA SHAPE="rect" ')
  1118.  
  1119.                     IF comment ~= '' THEN
  1120.                         CALL WRITECH('mfile', 'ALT="'comment'" ')
  1121.  
  1122.                     Get 'IMAGEW'
  1123.                     xmax = RESULT - 1
  1124.                     Get 'IMAGEH'
  1125.                     ymax = RESULT - 1
  1126.  
  1127.                     CALL WRITELN('mfile', 'COORDS="0,0,'xmax','ymax'" HREF="'url'">')
  1128.  
  1129.                     CALL CLOSE('obfile')
  1130.                 END
  1131.                 CALL WRITELN('mfile', '</MAP>')
  1132.                 CALL CLOSE('mfile')
  1133.  
  1134.                 IF point_found THEN
  1135.                     RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_expoint'"'
  1136.  
  1137.                 UnlockGUI
  1138.             END
  1139.             ELSE RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_export'"'
  1140.         END
  1141.     END
  1142.     ELSE RequestNotify 'TITLE "'global.txt_title_exprt'" PROMPT "'global.txt_err_nomap'"'
  1143.  
  1144.     RETURN
  1145.  
  1146.  
  1147.  
  1148. ClearMap: PROCEDURE EXPOSE global.
  1149.  
  1150.     IF GetObjectNum() > 0 THEN DO
  1151.         RequestResponse 'TITLE "'global.txt_title_clear'" PROMPT "'global.txt_msg_clear'"'
  1152.         IF RC = 0 THEN
  1153.             CALL Cleanup
  1154.     END
  1155.     ELSE RequestNotify 'TITLE "'global.txt_title_clear'" PROMPT "'global.txt_err_noclear'"'
  1156.  
  1157.     RETURN
  1158.  
  1159.  
  1160.  
  1161.  
  1162. PointString:
  1163.  
  1164.     INTERPRET('PROCEDURE EXPOSE' ARG(1)'.' ARG(2)'.')
  1165.  
  1166.     xname = ARG(1)
  1167.     yname = ARG(2)
  1168.     separ = ARG(3)
  1169.     ptnum = ARG(4)
  1170.  
  1171.     DO pt = 0 FOR ptnum
  1172.         ppoint = VALUE(xname'.'pt) || separ || VALUE(yname'.'pt)
  1173.         IF pt = 0 THEN
  1174.             ppoints = ppoint
  1175.         ELSE
  1176.             ppoints = ppoints ppoint
  1177.     END
  1178.  
  1179.     RETURN ppoints
  1180.  
  1181.  
  1182.  
  1183.  
  1184. InsertCommas: PROCEDURE EXPOSE global.
  1185.  
  1186.     param = ARG(1)
  1187.     wnum = WORDS(param)
  1188.  
  1189.     DO w = 1 TO wnum BY 2
  1190.         point = WORD(param, w) || ',' || WORD(param, w+1)
  1191.         IF w = 1 THEN
  1192.             cparam = point
  1193.         ELSE
  1194.             cparam = cparam point
  1195.     END
  1196.  
  1197.     RETURN cparam
  1198.  
  1199.  
  1200.  
  1201.  
  1202. RequestObject: PROCEDURE EXPOSE global.
  1203.  
  1204.     do_request = 1
  1205.  
  1206.     DO WHILE do_request
  1207.         title   = ARG(1)
  1208.         type    = ARG(2)
  1209.         param   = ARG(3)
  1210.         url     = ARG(4)
  1211.         comment = ARG(5)
  1212.         delgadg = ARG(6)
  1213.  
  1214.         do_request = 0
  1215.         is_def = (type = 'default')
  1216.  
  1217.         IF url = '' & ~is_def THEN
  1218.             url = global.last_url
  1219.  
  1220.         start_url = url
  1221.         start_param = param
  1222.  
  1223.         IF delgadg THEN
  1224.             reqact = 'ACTION = PROCEED ' ||,
  1225.                         'ACTION = ""'global.txt_gad_del'"" ' ||,
  1226.                         'ACTION = CANCEL '
  1227.         ELSE
  1228.             reqact = ''     /* PROCEED CANCEL */
  1229.  
  1230.         IF is_def THEN DO
  1231.             Request '"'CENTER(title, 44)'" RESIZE ',  /* spaces are used to properly size the requester */
  1232.                      '"STRING = ""'global.txt_gad_url'"", 200, ""'url'"" ',
  1233.                      ' STRING = ""'global.txt_gad_comm'"", 200, ""'comment'"" ',
  1234.                         reqact '"'
  1235.             IF RC = 0 & RESULT = 1 THEN DO    /* Proceed */
  1236.                 url     = RESULT.1
  1237.                 comment = RESULT.2
  1238.  
  1239.                 IF url = '' THEN
  1240.                     obj_data = 'delete'
  1241.                 ELSE
  1242.                     obj_data = '"'url'" "'comment'"'
  1243.             END
  1244.             ELSE IF RC = 0 & RESULT = 2 THEN        /* Delete */
  1245.                 obj_data = 'delete'
  1246.             ELSE
  1247.                 obj_data = 'cancel'
  1248.         END
  1249.         ELSE DO
  1250.             Request '"'CENTER(title, 44)'" RESIZE ',  /* spaces are used to properly size the requester */
  1251.                      '"STRING = ""'global.txt_gad_param'"", 1000, ""'param'"" ',
  1252.                      ' STRING = ""'global.txt_gad_url'"", 200, ""'url'"" ',
  1253.                      ' STRING = ""'global.txt_gad_comm'"", 200, ""'comment'"" ',
  1254.                         reqact '"'
  1255.             IF RC = 0 & RESULT = 1 THEN DO    /* Proceed */
  1256.                 param   = RESULT.1
  1257.                 url     = RESULT.2
  1258.                 comment = RESULT.3
  1259.                 newparam = (param ~= start_param)
  1260.  
  1261.                 IF      type = 'rect'   THEN    crdnum = 4
  1262.                 ELSE IF type = 'circle' THEN    crdnum = 4
  1263.                 ELSE IF type = 'point'  THEN    crdnum = 2
  1264.                 ELSE crdnum = 0    /* poly */
  1265.  
  1266.                 param = TRANSLATE(param, ' ', ',')
  1267.                 pnum = WORDS(param)
  1268.  
  1269.                 IF ~DATATYPE(pnum / 2, 'W') THEN
  1270.                     do_request = 1
  1271.                 IF crdnum > 0 & crdnum ~= pnum THEN
  1272.                     do_request = 1
  1273.                 IF ~do_request THEN DO
  1274.                     DO pn = 1 TO pnum
  1275.                         IF ~DATATYPE(WORD(param, pn), 'W') THEN DO
  1276.                             do_request = 1
  1277.                             LEAVE
  1278.                         END
  1279.                     END
  1280.                 END
  1281.                 IF do_request THEN
  1282.                     RequestNotify 'PROMPT "'global.txt_err_badpar'"'
  1283.                 ELSE IF url = '' THEN DO
  1284.                     do_request = 1
  1285.                     RequestNotify 'PROMPT "'global.txt_err_nourl'"'
  1286.                 END
  1287.                 IF ~do_request THEN
  1288.                     obj_data = newparam '"'param'" "'url'" "'comment'"'
  1289.             END
  1290.             ELSE IF RC = 0 & RESULT = 2 THEN        /* Delete */
  1291.                 obj_data = 'delete'
  1292.             ELSE
  1293.                 obj_data = 'cancel'
  1294.         END
  1295.         IF url ~= start_url & url ~= '' THEN
  1296.             global.last_url = url
  1297.     END
  1298.  
  1299.     RETURN obj_data
  1300.  
  1301.  
  1302.  
  1303.  
  1304. GetObjectNum: PROCEDURE EXPOSE global.
  1305.  
  1306.     obnum = 0
  1307.     IF OPEN('obnfile', global.basename || 'num', 'R') THEN DO
  1308.         obnum = READLN('obnfile')
  1309.         CALL CLOSE('obnfile')
  1310.     END
  1311.     RETURN obnum
  1312.  
  1313.  
  1314.  
  1315.  
  1316.  
  1317. SetObjectNum: PROCEDURE EXPOSE global.
  1318.  
  1319.     IF OPEN('obnfile', global.basename || 'num', 'W') THEN DO
  1320.         CALL WRITELN('obnfile', ARG(1))
  1321.         CALL CLOSE('obnfile')
  1322.     END
  1323.     RETURN
  1324.  
  1325.  
  1326.  
  1327.  
  1328. AddObject: PROCEDURE EXPOSE global.
  1329.  
  1330.     PARSE VALUE ARG(2) WITH . '"' param '" "' url '" "' comment '"'
  1331.     obnum = GetObjectNum()
  1332.     IF OPEN('obfile', global.basename || obnum, 'W') THEN DO
  1333.         CALL WRITELN('obfile', ARG(1))
  1334.         CALL WRITELN('obfile', param)
  1335.         CALL WRITELN('obfile', url)
  1336.         CALL WRITELN('obfile', comment)
  1337.         CALL CLOSE('obfile')
  1338.  
  1339.         CALL SetObjectNum(obnum + 1)
  1340.     END
  1341.     RETURN
  1342.  
  1343.  
  1344.  
  1345.  
  1346. XorObject: PROCEDURE EXPOSE global.
  1347.  
  1348.     obtype = ARG(1)
  1349.     param = ARG(2)
  1350.  
  1351.     IF obtype = 'point' THEN DO
  1352.         SetCurrentBrush 'RECTANGULAR WIDTH 5 HEIGHT 5'
  1353.         PutBrush param 'COMPLEMENT'
  1354.         SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  1355.         DisableTools
  1356.     END
  1357.     ELSE IF obtype = 'circle' THEN DO
  1358.         PARSE VAR param x0 y0 x1 y1 .
  1359.         GetDistance x0 y0 x1 y1 'IMAGERATIO'
  1360.         DrawCircle x0 y0 'RADIUSX' RESULT 'COMPLEMENT'
  1361.     END
  1362.     ELSE IF obtype = 'rect' THEN
  1363.         DrawRectangle param 'COMPLEMENT'
  1364.  
  1365.     ELSE IF obtype = 'poly' THEN
  1366.         DrawPolygon '"'param'" COMPLEMENT'
  1367.  
  1368.     RETURN
  1369.  
  1370.  
  1371.  
  1372.  
  1373. Cleanup: PROCEDURE EXPOSE global.
  1374.  
  1375.     LockGUI
  1376.     obnum = GetObjectNum()
  1377.  
  1378.     DO ob = 0 FOR obnum
  1379.         IF OPEN('obfile', global.basename || ob, 'R') THEN DO
  1380.             CALL XorObject(READLN('obfile'), READLN('obfile'))
  1381.             CALL CLOSE('obfile')
  1382.         END
  1383.     END
  1384.     ADDRESS COMMAND 'Delete >NIL: 'global.basename'#?'
  1385.     UnlockGUI
  1386.  
  1387.     RETURN
  1388.  
  1389.  
  1390.  
  1391.  
  1392. Break_C:
  1393.  
  1394.     CALL Cleanup
  1395.  
  1396.     SetPen 'FOREGROUND' savepen
  1397.     SetCurrentBrush savebsh
  1398.     Set '"BARS='savebars'"'
  1399.     Set '"GCLIP='saveclip'"'
  1400.     EnableTools
  1401.  
  1402.     RETURN
  1403.